Introduction

The goal of study 3 was to…

Methods

library(tidyverse)
library(ggdist)
library(ggside)
library(easystats)
library(patchwork)
library(brms)

source("../study2/functions.R")

# Variables
DVs <- c("Delboeuf" = "#2196F3", 
         "Ebbinghaus" = "#3F51B5", 
         "RodFrame" = "#F44336", 
         "VerticalHorizontal" = "#FF5722", 
         "Zollner" = "#FF9800", 
         "White" = "#9E9E9E", 
         "MullerLyer" = "#4CAF50", 
         "Ponzo" = "#009688", 
         "Poggendorff" = "#795548", 
         "Contrast" = "#607D8B", 
         "I" = "#9C27B0")

# Load data
dfsub <- read.csv("../data/study3.csv") |>
  mutate(
    Screen_Refresh = as.numeric(Screen_Refresh),
    Education = fct_relevel(Education, "High School", "Bachelor", "Master", "Doctorate", "Other", "Prefer not to Say")
  ) |> 
  datawizard::standardise(select=names(DVs)) |> 
  datawizard::change_scale(select=starts_with("IPIP"), to = c(0, 1), range = c(0, 100)) |> 
  datawizard::change_scale(select=starts_with("PID"), to = c(0, 1), range = c(0, 100)) 

# Remove outliers (p < 0.0001)
dfsub[names(DVs)][abs(dfsub[names(DVs)]) > qnorm(0.9999)] <- NA 

dflong <- dfsub |> 
  pivot_longer(all_of(names(DVs)), names_to = "Index", values_to = "Score")

Participants

8 participants did not do the personality scales.

p_age <- estimate_density(dfsub$Age) |> 
  ggplot(aes(x = x, y = y)) +
  geom_area(fill = "#607D8B") +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(title = "Age", color = NULL) +
  theme_modern() +
  theme(
    plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
    plot.subtitle = element_text(face = "italic", hjust = 0.5),
    # axis.line.y = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x = element_text(size=rel(0.6)),
    axis.title.x = element_blank()
  ) 

p_nat <- dfsub |> 
  group_by(Nationality) |> 
  summarize(n = n()) |> 
  mutate(Nationality = fct_reorder(Nationality, desc(n))) |> 
  ggplot(aes(x = Nationality, y = n, fill=Nationality)) +
  geom_bar(stat = "identity") +
  labs(y = "Number", title = "Nationality") +
  scale_fill_material_d(guide = "none") +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  theme_modern() +
  theme(
    plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
    plot.subtitle = element_text(face = "italic", hjust = 0.5),
    # axis.line.y = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_text(size=rel(0.6)),
    axis.text.x = element_text(size=rel(0.5), angle = 45, hjust=1)
  )

ggsave("figures/figure_dem1.png", 
       patchwork::wrap_elements(p_age / p_nat), 
       width=0.5*(fig.height), 
       height=1*(fig.height), dpi=1000, bg="white")


p_sex <- plot_waffle(dfsub, what="Sex", rows = 10, size=5) +
  scale_color_manual(values = c("Male" = "#2196F3", "Female" = "#E91E63")) 

p_edu <- plot_waffle(dfsub, "Education", rows = 10, size=5) +
  scale_color_viridis_d() 

p_race <- plot_waffle(dfsub, "Ethnicity", rows = 10, size=5) +
  scale_color_manual(values = c("Latino" = "#FF5722", "Caucasian" = "#2196F3", "African" = "#4CAF50", "Other" = "#795548")) 


ggsave("figures/figure_dem2.png", 
       patchwork::wrap_elements(p_sex / p_edu / p_race), width=1*(fig.height), height=1*(fig.height), dpi=1000, bg="white")



p_ipip <- dfsub |> 
  select(starts_with("IPIP") & !ends_with("_SD")) |> 
  estimate_density() |> 
  mutate(Parameter = str_remove_all(Parameter, "IPIP6_"),
         Parameter = str_replace(Parameter, "HonestyHumility", "Honesty-Humility")) |> 
  ggplot(aes(x = x, y = y, color = Parameter)) +
  geom_line(size = 1) +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_color_manual(values=c("Agreeableness" = "#FFC107", "Honesty-Humility" = "#00BCD4", "Extraversion" = "#9C27B0", "Conscientiousness" = "#3F51B5", "Openness" = "#4CAF50", "Neuroticism" = "#E91E63")) +
  labs(x = "Score", title = "Normal Personality", color = NULL) +
  theme_modern() +
  theme(
    plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x = element_text(size=rel(0.6)),
    axis.title.x = element_blank(),
    legend.text = element_text(size=rel(0.8))
    # legend.position = "top",
  ) 
  
p_pid <- dfsub |> 
  select(starts_with("PID") & !ends_with("_SD")) |> 
  estimate_density() |> 
  mutate(Parameter = str_remove_all(Parameter, "PID5_"),
         Parameter = str_replace(Parameter, "NegativeAffect", "Negative Affect")) |> 
  ggplot(aes(x = x, y = y, color = Parameter)) +
  geom_line(size = 1) +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_color_manual(values=c("Antagonism" = "#FF9800", "Detachment" = "#03A9F4", "Disinhibition" = "#FF5722", "Negative Affect" = "#F44336", "Psychoticism" = "#673AB7")) +
  labs(x = "Score", title = "Pathological Personality", color = NULL) +
  theme_modern() +
  theme(
    plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x = element_text(size=rel(0.6)),
    axis.title.x = element_blank(),
    legend.text = element_text(size=rel(0.8))
    # legend.position = "top",
  ) 


ggsave("figures/figure_dem3.png", 
       patchwork::wrap_elements(p_ipip / p_pid), width=2/3*(fig.height), height=1*(fig.height), dpi=1000, bg="white")



p_dem <- (
  patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem1.png"), interpolate = TRUE)) | 
    patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem2.png"), interpolate = TRUE)) | 
    patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem3.png"), interpolate = TRUE))
) + 
  patchwork::plot_layout(widths=c(1/2, 1, 2/3)) + 
  patchwork::plot_annotation(title = "Participants (n = 250)", 
                             theme = theme(plot.title = element_text(size = rel(1.5), face="bold", hjust=0.5, vjust=-5)))

ggsave("figures/figure_dem.png", p_dem, dpi=1000)
## Saving 11.3 x 7 in image

p_dem

Results

Contextual

Screen Size

preds <- data.frame()
for(i in names(DVs)) {
  # model <- brms::brm(paste0(i, " ~ s(Screen_Size)"), data=dfsub, algorithm = "meanfield", refresh=0)
  # param <- bayestestR::describe_posterior(as.data.frame(model))
  model <- lm(as.formula(paste0(i, " ~ Screen_Size")), 
              data=dfsub)
  param <- parameters::parameters(model)
  
  pred <- estimate_relation(model, length=50)
  pred$Index <- i
  pred$sig <- param$p[2]
  preds <- rbind(preds, pred)
  
  if(any(pred$sig < .05)) {
    print(i)
  }
}
## [1] "White"
## [1] "Contrast"

preds |> 
  mutate(sig = format_p(sig, stars_only = TRUE),
         sig = ifelse(sig == "", "NS", sig)) |> 
  ggplot(aes(x = Screen_Size, y = Predicted)) +
  geom_point2(data=dflong, aes(y = Score, color= Index), alpha=0.1, size=2) +
  geom_line(aes(color = Index, group = Index, linetype = sig, size = sig)) +
  scale_x_continuous(expand = c(0, 0)) +
  scale_size_manual(values = c("NS" = 0.5, "*" = 1)) +
  scale_linetype_manual(values = c("NS" = "dotted", "*" = "solid")) +
  scale_color_manual(values = DVs) +
  coord_cartesian(ylim = c(-2.5, 2.5)) +
  theme_modern() +
  labs(y = "Illusion Sensitivity", x = "Screen Size", linetype="Significance", size="Significance") +
  ggside::geom_xsidedensity(data=dfsub, fill ="grey", color = "white") +
  ggside::geom_ysidedensity(data=dflong, aes(y=Score, color = Index)) +
  ggside::theme_ggside_void() +
  ggside::scale_ysidex_continuous(expand = c(0, 0)) +
  ggside::scale_xsidey_continuous(expand = c(0, 0))

Refresh Rate

preds <- data.frame()
for(i in names(DVs)) {
  # model <- brms::brm(paste0(i, " ~ s(Screen_Refresh)"), data=dfsub, algorithm = "meanfield", refresh=0)
  # param <- bayestestR::describe_posterior(as.data.frame(model))
  model <- lm(as.formula(paste0(i, " ~ Screen_Refresh")), 
              data=dfsub)
  param <- parameters::parameters(model)
  
  pred <- estimate_relation(model, length=50)
  pred$Index <- i
  pred$sig <- param$p[2]
  preds <- rbind(preds, pred)
  
  if(any(pred$sig < .05)) {
    print(i)
  }
}

preds |> 
  mutate(sig = format_p(sig, stars_only = TRUE),
         sig = ifelse(sig == "", "NS", sig)) |> 
  ggplot(aes(x = Screen_Refresh, y = Predicted)) +
  geom_point2(data=dflong, aes(y = Score, color= Index), alpha=0.1, size=2) +
  geom_line(aes(color = Index, group = Index, linetype = sig, size = sig)) +
  scale_x_continuous(expand = c(0, 0)) +
  scale_size_manual(values = c("NS" = 0.5, "*" = 1)) +
  scale_linetype_manual(values = c("NS" = "dotted", "*" = "solid")) +
  scale_color_manual(values = DVs) +
  coord_cartesian(ylim = c(-2.5, 2.5)) +
  theme_modern() +
  labs(y = "Illusion Sensitivity", x = "Screen Refresh Rate", linetype="Significance", size="Significance") +
  ggside::geom_xsidedensity(data=dfsub, fill ="grey", color = "white") +
  ggside::geom_ysidedensity(data=dflong, aes(y=Score, color = Index)) +
  ggside::theme_ggside_void() +
  ggside::scale_ysidex_continuous(expand = c(0, 0)) +
  ggside::scale_xsidey_continuous(expand = c(0, 0))

Demographics

Sex

sig <- list()
params <- data.frame()
for(i in names(DVs)) {
  model <- lm(paste0(i, " ~ Sex"), data=dfsub)
  param <- parameters::parameters(model)
  param$Index <- i
  param$ymiddle <- param$Coefficient[1] + diff(param$Coefficient) / 2
  param$BF <- parameters::parameters(BayesFactor::ttestBF(formula=as.formula(paste0(i, " ~ Sex")), data=dfsub[!is.na(dfsub[[i]]), ]))$BF
  params <- rbind(params, as.data.frame(param[2, ]))
}

data <- dfsub |> 
  pivot_longer(all_of(names(DVs)), names_to = "Index", values_to = "Score") |> 
  mutate(Index = fct_relevel(Index, names(DVs)),
         Index = fct_relabel(Index, ~prettify_itemName(.x)))  # arrange(params, p)$Index 

p_gender <- data |> 
  ggplot(aes(x = Index, y = Score)) +
  stat_slab(data=filter(data, Sex == "Male"), aes(fill = Sex), side = "left", scale = 0.5, position = "dodge") +
  stat_slab(data=filter(data, Sex == "Female"), aes(fill = Sex), side = "right", scale = 0.5, position = "dodge") +
  stat_pointinterval(aes(group = fct_rev(Sex)), point_interval = "mean_qi", position = "dodge") +
  geom_text(data = mutate(params, sig = insight::format_p(p, stars_only = TRUE), Index = prettify_itemName(Index)), aes(label = sig, y = ymiddle)) +
    geom_label(data = mutate(params, label = insight::format_bf(BF), Index = prettify_itemName(Index)), 
             aes(label = label), y=2.7) +
  scale_fill_manual(values = c("Male" = "#2196F3", "Female" = "#E91E63")) +
  theme_minimal() +
  labs(title = "Illusion Sensitivity Scores", fill = "") +
  theme(legend.position = "top",
        axis.title = element_blank(),
        plot.title = element_text(face = "bold", hjust=0.5)) 

p_gender

ggsave("figures/figure_sex.png", p_gender, width=2*(fig.height), height=0.8*(fig.height), dpi=600, bg="white")